home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0195.ZIP / ALLFILES.LIB < prev    next >
Text File  |  1984-12-21  |  7KB  |  177 lines
  1. {@@@@@@@@@@@@@@@@@@@ copyright 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@
  2.  
  3.  ALLFILES(ulCol, ulRow, lrCol, lrRow : byte;
  4.                         VAR template : filename_type;
  5.                     VAR error_return : byte);
  6.  
  7. Pass the UpperLeft and LowerRight corners of the window in which selection
  8. is to take place and the template (e.g., 'c:\whammy\*.*') of the files to
  9. be scanned.  Returns the selected filename in "template", or an error code.
  10. The width of the window must be at least 18 characters--36 gives two columns.
  11.  
  12. If the user "breaks out" of the selection process by pressing <Esc>, the
  13. error return code is set to 255.
  14.  
  15.   REQUIRES : filename.typ
  16.              regpack.typ
  17.              getkeys.lib
  18.              monitor.lib
  19.              screen.lib
  20.              getfile.lib
  21.     These files must also be INCLUDEd in a program that uses ALLFILES.
  22. }
  23.  
  24. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  25.  procedure Frame(ulC, ulR, lrC, lrR: byte);   { Upper Left and Lower Right
  26.                                                 Row and Column }
  27.    var
  28.       I:byte;
  29.    begin
  30.       GotoXY(ulC, ulR);  Write(chr(201));
  31.       for I:=ulC+1 to lrC-1 do Write(chr(205));
  32.       Write(chr(187));
  33.       for I:=ulR+1 to lrR-1 do
  34.       begin
  35.          GotoXY(ulC , I);  Write(chr(186));
  36.          GotoXY(lrC, I);  Write(chr(186));
  37.       end;
  38.       GotoXY(ulC, lrR);
  39.       Write(chr(200));
  40.       for i:=ulC+1 to lrC-1 do Write(chr(205));
  41.       Write(chr(188));
  42.    end;
  43.  
  44.  
  45. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  46. procedure AllFiles(ulCol, ulRow, lrCol, lrRow : byte;
  47.                                  VAR template : filename_type;
  48.                              VAR error_return : byte);
  49. var
  50.   OneChar, choice, EscChoice            : char;
  51.   attrib, error, margin, count, HowDeep : byte;
  52.   {-------------------------------------------------------------------}
  53.    procedure Do_select(VAR name : filename_type);
  54.    var
  55.      N, X, Y, loc : byte;
  56.      {----------------------------------------------------------}
  57.       procedure transloc(loc:byte; var X,Y:byte);  { translates a numeric  }
  58.       begin                                        { location ("7th file") }
  59.         X := ((loc-1) div (howDeep-1))*18 + ulCol; { into X and Y coordin- }
  60.         Y := (loc-1) mod (howDeep-1) + ulRow;      { ates and writes a     }
  61.         WriteScreen(X,Y,chr(16),112);              { pointer at those      }
  62.       end;                                         { coordinates.          }
  63.      {----------------------------------------------------------}
  64.    begin
  65.      loc := 1;
  66.      transloc(loc,X,Y);
  67.      gotoXY(X-ulCol+1,Y-ulRow+1);    { This line keeps the normal cursor
  68.                                        in the same place as the pointer. }
  69.      repeat
  70.        getKeys(choice, EscChoice);
  71.          if choice = chr(27) then
  72.            begin
  73.            case EscChoice of
  74.              'H': begin
  75.                     WriteScreen(X,Y,' ',15);
  76.                     if loc > 1 then loc := loc - 1 else loc := count;
  77.                     transloc(loc,X,Y);
  78.                   end;
  79.                   { UP arrrow.  If the LOCation is any but the first, it
  80.                     just decrements by one.  If it's the first, it becomes
  81.                     the last.  Thus there's a "wrap" effect. }
  82.              'P': begin
  83.                     WriteScreen(X,Y,' ',15);
  84.                     if loc < count then loc := loc + 1 else loc := 1;
  85.                     transloc(loc,X,Y);
  86.                   end;
  87.                   { DOWN arrow.  Increments LOCation by one.  If already
  88.                     at the end, "wraps" to beginning. }
  89.              'K': begin
  90.                     WriteScreen(X,Y,' ',15);
  91.                     if loc > (howDeep - 1) then loc := loc - (howDeep - 1) else
  92.                       begin
  93.                         loc := loc + 5*(howDeep-1);
  94.                         while loc > count do loc := loc - (howDeep - 1);
  95.                       end;
  96.                     transloc(loc,X,Y);
  97.                   end;
  98.                   { LEFT arrow.  Moves to same screen line one column to
  99.                     the left.  If already at leftmost column, goes to far
  100.                     right column. }
  101.              'M': begin
  102.                     WriteScreen(X,Y,' ',15);
  103.                     loc := loc + HowDeep - 1;
  104.                     if loc > count then loc := loc mod (HowDeep - 1) ;
  105.                     if loc = 0 then loc := HowDeep - 1;
  106.                     transloc(loc,X,Y);
  107.                   end;
  108.                   { RIGHT arrow.  Moves to same screen line one column to
  109.                     the right.  If already at rightmost, goes to far left. }
  110.            end; {case}
  111.            GotoXY(X-ulCol+1,Y-ulRow+1);  { Put the normal cursor in the
  112.                                            same place as the pointer.  }
  113.          end;  { if }
  114.      until (choice = #13) or ((choice = #27) and (EscChoice = #0));
  115.      if choice = #27 then error_return := 255;
  116.      name := '';
  117.  { Now we pick the selected name right off the screen. }
  118.      for N := 1 to 13 do
  119.        begin
  120.          oneChar := ReadScreen(X+N,Y);
  121.          if not (oneChar in [#0,#32]) then name := name + oneChar;
  122.        end;
  123.      window(ulCol-1,ulRow-2,lrCol+1,lrRow+1);
  124.      ClrScr;
  125.      window(1,1,80,25);
  126.   end;
  127.   {-------------------------------------------------------------------}
  128. begin
  129.   GotoXY(ulCol,ulRow-1);ClrEOL;
  130.   Write('Move w/ arrows, select w/ <Return>');
  131.   frame(ulCol-1,ulRow-2,lrCol+1,lrRow+1);
  132.   window(ulCol,ulRow,lrCol,lrRow);
  133.   ClrScr;
  134.   howDeep := lrRow - ulRow;
  135.   attrib := 32;
  136.   buffer.name := '             ';
  137.   Find_First(attrib, template, error);
  138.   error_return := error;
  139.   if error = 0 then
  140.     begin
  141.       count := 1;
  142.       margin := 2;
  143.       GotoXy(margin,WhereY);
  144.       WriteLn(template);
  145.       repeat
  146.         buffer.name := '             ';
  147.         find_Next(attrib,template,error);
  148.         if error = 0 then
  149.           begin
  150.             gotoXY(margin,WhereY);
  151.             writeLn(template);
  152.             count := count + 1;
  153.             if WhereY > HowDeep-1 then
  154.               begin
  155.                 margin := margin + 18;
  156.                 gotoXY(margin,1);
  157.               end;
  158.             if count >= ((HowDeep-1)*(((lrCol-ulCol) div 18))) then
  159.               begin
  160.                 GotoXY(1,HowDeep);
  161.                 Write('Any key to see more, <CR> to stay');
  162.                 GetKeys(choice,EscChoice);
  163.                 gotoXY(1,HowDeep);ClrEOL;
  164.                 if choice = #13 then error := 1
  165.                 else
  166.                   begin
  167.                     ClrScr;
  168.                     count := 0;
  169.                     margin := 2;
  170.                   end;
  171.               end;
  172.           end;
  173.       until error <> 0;
  174.       do_select(template);
  175.     end;
  176. end;
  177.